home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / dsgnintf.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-30  |  74.5 KB  |  2,544 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,97 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DsgnIntf;
  11.  
  12. interface
  13.  
  14. {$N+,S-,R-}
  15.  
  16. uses SysUtils, Classes, Graphics, Controls, Forms, TypInfo;
  17.  
  18. type
  19.  
  20. { TComponentList }
  21.  
  22.   TComponentList = class(TObject)
  23.   private
  24.     FList: TList;
  25.     function Get(Index: Integer): TPersistent;
  26.     function GetCount: Integer;
  27.   public
  28.     constructor Create;
  29.     destructor Destroy; override;
  30.     function Add(Item: TPersistent): Integer;
  31.     function Equals(List: TComponentList): Boolean;
  32.     property Count: Integer read GetCount;
  33.     property Items[Index: Integer]: TPersistent read Get; default;
  34.   end;
  35.  
  36. { Forward declaration }
  37.  
  38.   TComponentEditor = class;
  39.  
  40. { TFormDesigner }
  41.  
  42.   TFormDesigner = class(TDesigner)
  43.   public
  44.     function CreateMethod(const Name: string; TypeData: PTypeData): TMethod; virtual; abstract;
  45.     function GetMethodName(const Method: TMethod): string; virtual; abstract;
  46.     procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc); virtual; abstract;
  47.     function GetPrivateDirectory: string; virtual; abstract;
  48.     procedure GetSelections(List: TComponentList); virtual; abstract;
  49.     function MethodExists(const Name: string): Boolean; virtual; abstract;
  50.     procedure RenameMethod(const CurName, NewName: string); virtual; abstract;
  51.     procedure SelectComponent(Instance: TPersistent); virtual; abstract;
  52.     procedure SetSelections(List: TComponentList); virtual; abstract;
  53.     procedure ShowMethod(const Name: string); virtual; abstract;
  54.     function UniqueName(const BaseName: string): string; virtual; abstract;
  55.     procedure GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc); virtual; abstract;
  56.     function GetComponent(const Name: string): TComponent; virtual; abstract;
  57.     function GetComponentName(Component: TComponent): string; virtual; abstract;
  58.     function GetObject(const Name: string): TPersistent; virtual; abstract;
  59.     function GetObjectName(Instance: TPersistent): string; virtual; abstract;
  60.     procedure GetObjectNames(TypeData: PTypeData; Proc: TGetStrProc); virtual; abstract;
  61.     function MethodFromAncestor(const Method: TMethod): Boolean; virtual; abstract;
  62.     function CreateComponent(ComponentClass: TComponentClass; Parent: TComponent;
  63.       Left, Top, Width, Height: Integer): TComponent; virtual; abstract;
  64.     function IsComponentLinkable(Component: TComponent): Boolean; virtual; abstract;
  65.     procedure MakeComponentLinkable(Component: TComponent); virtual; abstract;
  66.     function GetRoot: TComponent; virtual; abstract;
  67.     procedure Revert(Instance: TPersistent; PropInfo: PPropInfo); virtual; abstract;
  68.     function GetIsDormant: Boolean; virtual; abstract;
  69.     property IsDormant: Boolean read GetIsDormant;
  70.   end;
  71.  
  72. { TPropertyEditor
  73.   Edits a property of a component, or list of components, selected into the
  74.   Object Inspector.  The property editor is created based on the type of the
  75.   property being edited as determined by the types registered by
  76.   RegisterPropertyEditor.  The Object Inspector uses the a TPropertyEditor
  77.   for all modification to a property. GetName and GetValue are called to display
  78.   the name and value of the property.  SetValue is called whenever the user
  79.   requests to change the value.  Edit is called when the user double-clicks the
  80.   property in the Object Inspector. GetValues is called when the drop-down
  81.   list of a property is displayed.  GetProperties is called when the property
  82.   is expanded to show sub-properties.  AllEqual is called to decide whether or
  83.   not to display the value of the property when more than one component is
  84.   selected.
  85.  
  86.   The following are methods that can be overriden to change the behavior of
  87.   the property editor:
  88.  
  89.     Activate
  90.       Called whenever the property becomes selected in the object inspector.
  91.       This is potientially useful to allow certian property attributes to
  92.       to only be determined whenever the property is selected in the object
  93.       inspector. Only paSubProperties and paMultiSelect, returned from
  94.       GetAttributes, need to be accurate before this method is called.
  95.     AllEqual
  96.       Called whenever there are more than one components selected.  If this
  97.       method returns true, GetValue is called, otherwise blank is displayed
  98.       in the Object Inspector.  This is called only when GetAttributes
  99.       returns paMultiSelect.
  100.     Edit
  101.       Called when the '...' button is pressed or the property is double-clicked.
  102.       This can, for example, bring up a dialog to allow the editing the
  103.       component in some more meaningful fashion than by text (e.g. the Font
  104.       property).
  105.     GetAttributes
  106.       Returns the information for use in the Object Inspector to be able to
  107.       show the approprate tools.  GetAttributes return a set of type
  108.       TPropertyAttributes:
  109.         paValueList:     The property editor can return an enumerated list of
  110.                          values for the property.  If GetValues calls Proc
  111.                          with values then this attribute should be set.  This
  112.                          will cause the drop-down button to appear to the right
  113.                          of the property in the Object Inspector.
  114.         paSortList:      Object Inspector to sort the list returned by
  115.                          GetValues.
  116.         paSubProperties: The property editor has sub-properties that will be
  117.                          displayed indented and below the current property in
  118.                          standard outline format. If GetProperties will
  119.                          generate property objects then this attribute should
  120.                          be set.
  121.         paDialog:        Indicates that the Edit method will bring up a
  122.                          dialog.  This will cause the '...' button to be
  123.                          displayed to the right of the property in the Object
  124.                          Inspector.
  125.         paMultiSelect:   Allows the property to be displayed when more than
  126.                          one component is selected.  Some properties are not
  127.                          approprate for multi-selection (e.g. the Name
  128.                          property).
  129.         paAutoUpdate:    Causes the SetValue method to be called on each
  130.                          change made to the editor instead of after the change
  131.                          has been approved (e.g. the Caption property).
  132.         paReadOnly:      Value is not allowed to change.
  133.         paRevertable:    Allows the property to be reverted to the original
  134.                          value.  Things that shouldn't be reverted are nested
  135.                          properties (e.g. Fonts) and elements of a composite
  136.                          property such as set element values.
  137.     GetComponent
  138.       Returns the Index'th component being edited by this property editor.  This
  139.       is used to retieve the components.  A property editor can only refer to
  140.       multiple components when paMultiSelect is returned from GetAttributes.
  141.     GetEditLimit
  142.       Returns the number of character the user is allowed to enter for the
  143.       value.  The inplace editor of the object inspector will be have its
  144.       text limited set to the return value.  By default this limit is 255.
  145.     GetName
  146.       Returns a the name of the property.  By default the value is retrieved
  147.       from the type information with all underbars replaced by spaces.  This
  148.       should only be overriden if the name of the property is not the name
  149.       that should appear in the Object Inspector.
  150.     GetProperties
  151.       Should be overriden to call PropertyProc for every sub-property (or nested
  152.       property) of the property begin edited and passing a new TPropertyEdtior
  153.       for each sub-property.  By default, PropertyProc is not called and no
  154.       sub-properties are assumed.  TClassProperty will pass a new property
  155.       editor for each published property in a class.  TSetProperty passes a
  156.       new editor for each element in the set.
  157.     GetPropType
  158.       Returns the type information pointer for the propertie(s) being edited.
  159.     GetValue
  160.       Returns the string value of the property. By default this returns
  161.       '(unknown)'.  This should be overriden to return the appropriate value.
  162.     GetValues
  163.       Called when paValueList is returned in GetAttributes.  Should call Proc
  164.       for every value that is acceptable for this property.  TEnumProperty
  165.       will pass every element in the enumeration.
  166.     Initialize
  167.       Called after the property editor has been created but before it is used.
  168.       Many times property editors are created and because they are not a common
  169.       property across the entire selection they are thrown away.  Initialize is
  170.       called after it is determined the property editor is going to be used by
  171.       the object inspector and not just thrown away.
  172.     SetValue(Value)
  173.       Called to set the value of the property.  The property editor should be
  174.       able to translate the string and call one of the SetXxxValue methods. If
  175.       the string is not in the correct format or not an allowed value, the
  176.       property editor should generate an exception describing the problem. Set
  177.       value can ignore all changes and allow all editing of the property be
  178.       accomplished through the Edit method (e.g. the Picture property).
  179.  
  180.   Properties and methods useful in creating a new TPropertyEditor classes:
  181.  
  182.     Name property
  183.       Returns the name of the property returned by GetName
  184.     PrivateDirectory property
  185.       It is either the .EXE or the "working directory" as specified in
  186.       DELPHI32.INI.  If the property editor needs auxilury or state files
  187.       (templates, examples, etc) they should be stored in this directory.
  188.     Properties indexed property
  189.       The TProperty objects representing all the components being edited
  190.       by the property editor.  If more than one component is selected, one
  191.       TProperty object is created for each component.  Typically, it is not
  192.       necessary to use this array since the Get/SetXxxValue methods will
  193.       propagate the values appropriatly.
  194.     Value property
  195.       The current value, as a string, of the property as returned by GetValue.
  196.     Modified
  197.       Called to indicate the value of the property has been modified.  Called
  198.       automatically by the SetXxxValue methods.  If you call a TProperty
  199.       SetXxxValue method directly, you *must* call Modified as well.
  200.     GetXxxValue
  201.       Gets the value of the first property in the Properties property.  Calls
  202.       the appropriate TProperty GetXxxValue method to retrieve the value.
  203.     SetXxxValue
  204.       Sets the value of all the properties in the Properties property.  Calls
  205.       the approprate TProperty SetXxxxValue methods to set the value. }
  206.  
  207.   TPropertyAttribute = (paValueList, paSubProperties, paDialog,
  208.     paMultiSelect, paAutoUpdate, paSortList, paReadOnly, paRevertable);
  209.   TPropertyAttributes = set of TPropertyAttribute;
  210.  
  211.   TPropertyEditor = class;
  212.  
  213.   TInstProp = record
  214.     Instance: TPersistent;
  215.     PropInfo: PPropInfo;
  216.   end;
  217.  
  218.   PInstPropList = ^TInstPropList;
  219.   TInstPropList = array[0..1023] of TInstProp;
  220.  
  221.   TGetPropEditProc = procedure(Prop: TPropertyEditor) of object;
  222.  
  223.   TPropertyEditor = class
  224.   private
  225.     FDesigner: TFormDesigner;
  226.     FPropList: PInstPropList;
  227.     FPropCount: Integer;
  228.     constructor Create(ADesigner: TFormDesigner; APropCount: Integer);
  229.     function GetPrivateDirectory: string;
  230.     procedure SetPropEntry(Index: Integer; AInstance: TPersistent;
  231.       APropInfo: PPropInfo);
  232.   protected
  233.     function GetPropInfo: PPropInfo;
  234.     function GetFloatValue: Extended;
  235.     function GetFloatValueAt(Index: Integer): Extended;
  236.     function GetMethodValue: TMethod;
  237.     function GetMethodValueAt(Index: Integer): TMethod;
  238.     function GetOrdValue: Longint;
  239.     function GetOrdValueAt(Index: Integer): Longint;
  240.     function GetStrValue: string;
  241.     function GetStrValueAt(Index: Integer): string;
  242.     function GetVarValue: Variant;
  243.     function GetVarValueAt(Index: Integer): Variant;
  244.     procedure Modified;
  245.     procedure SetFloatValue(Value: Extended);
  246.     procedure SetMethodValue(const Value: TMethod);
  247.     procedure SetOrdValue(Value: Longint);
  248.     procedure SetStrValue(const Value: string);
  249.     procedure SetVarValue(const Value: Variant);
  250.   public
  251.     destructor Destroy; override;
  252.     procedure Activate; virtual;
  253.     function AllEqual: Boolean; virtual;
  254.     procedure Edit; virtual;
  255.     function GetAttributes: TPropertyAttributes; virtual;
  256.     function GetComponent(Index: Integer): TPersistent;
  257.     function GetEditLimit: Integer; virtual;
  258.     function GetName: string; virtual;
  259.     procedure GetProperties(Proc: TGetPropEditProc); virtual;
  260.     function GetPropType: PTypeInfo;
  261.     function GetValue: string; virtual;
  262.     procedure GetValues(Proc: TGetStrProc); virtual;
  263.     procedure Initialize; virtual;
  264.     procedure Revert;
  265.     procedure SetValue(const Value: string); virtual;
  266.     function ValueAvailable: Boolean;
  267.     property Designer: TFormDesigner read FDesigner;
  268.     property PrivateDirectory: string read GetPrivateDirectory;
  269.     property PropCount: Integer read FPropCount;
  270.     property Value: string read GetValue write SetValue;
  271.   end;
  272.  
  273.   TPropertyEditorClass = class of TPropertyEditor;
  274.  
  275. { TOrdinalProperty
  276.   The base class of all ordinal property editors.  It established that ordinal
  277.   properties are all equal if the GetOrdValue all return the same value. }
  278.  
  279.   TOrdinalProperty = class(TPropertyEditor)
  280.     function AllEqual: Boolean; override;
  281.     function GetEditLimit: Integer; override;
  282.   end;
  283.  
  284. { TIntegerProperty
  285.   Default editor for all Longint properties and all subtypes of the Longint
  286.   type (i.e. Integer, Word, 1..10, etc.).  Retricts the value entrered into
  287.   the property to the range of the sub-type. }
  288.  
  289.   TIntegerProperty = class(TOrdinalProperty)
  290.   public
  291.     function GetValue: string; override;
  292.     procedure SetValue(const Value: string); override;
  293.   end;
  294.  
  295. { TCharProperty
  296.   Default editor for all Char properties and sub-types of Char (i.e. Char,
  297.   'A'..'Z', etc.). }
  298.  
  299.   TCharProperty = class(TOrdinalProperty)
  300.   public
  301.     function GetValue: string; override;
  302.     procedure SetValue(const Value: string); override;
  303.   end;
  304.  
  305. { TEnumProperty
  306.   The default property editor for all enumerated properties (e.g. TShape =
  307.   (sCircle, sTriangle, sSquare), etc.). }
  308.  
  309.   TEnumProperty = class(TOrdinalProperty)
  310.   public
  311.     function GetAttributes: TPropertyAttributes; override;
  312.     function GetValue: string; override;
  313.     procedure GetValues(Proc: TGetStrProc); override;
  314.     procedure SetValue(const Value: string); override;
  315.   end;
  316.  
  317.   TBoolProperty = class(TEnumProperty)
  318.     function GetValue: string; override;
  319.     procedure GetValues(Proc: TGetStrProc); override;
  320.     procedure SetValue(const Value: string); override;
  321.   end;
  322.  
  323. { TFloatProperty
  324.   The default property editor for all floating point types (e.g. Float,
  325.   Single, Double, etc.) }
  326.  
  327.   TFloatProperty = class(TPropertyEditor)
  328.   public
  329.     function AllEqual: Boolean; override;
  330.     function GetValue: string; override;
  331.     procedure SetValue(const Value: string); override;
  332.   end;
  333.  
  334. { TStringProperty
  335.   The default property editor for all strings and sub types (e.g. string,
  336.   string[20], etc.). }
  337.  
  338.   TStringProperty = class(TPropertyEditor)
  339.   public
  340.     function AllEqual: Boolean; override;
  341.     function GetEditLimit: Integer; override;
  342.     function GetValue: string; override;
  343.     procedure SetValue(const Value: string); override;
  344.   end;
  345.  
  346. { TSetElementProperty
  347.   A property editor that edits an individual set element.  GetName is
  348.   changed to display the set element name instead of the property name and
  349.   Get/SetValue is changed to reflect the individual element state.  This
  350.   editor is created by the TSetProperty editor. }
  351.  
  352.   TSetElementProperty = class(TPropertyEditor)
  353.   private
  354.     FElement: Integer;
  355.     constructor Create(ADesigner: TFormDesigner; APropList: PInstPropList;
  356.       APropCount: Integer; AElement: Integer);
  357.   public
  358.     destructor Destroy; override;
  359.     function AllEqual: Boolean; override;
  360.     function GetAttributes: TPropertyAttributes; override;
  361.     function GetName: string; override;
  362.     function GetValue: string; override;
  363.     procedure GetValues(Proc: TGetStrProc); override;
  364.     procedure SetValue(const Value: string); override;
  365.    end;
  366.  
  367. { TSetProperty
  368.   Default property editor for all set properties. This editor does not edit
  369.   the set directly but will display sub-properties for each element of the
  370.   set. GetValue displays the value of the set in standard set syntax. }
  371.  
  372.   TSetProperty = class(TOrdinalProperty)
  373.   public
  374.     function GetAttributes: TPropertyAttributes; override;
  375.     procedure GetProperties(Proc: TGetPropEditProc); override;
  376.     function GetValue: string; override;
  377.   end;
  378.  
  379. { TClassProperty
  380.   Default property editor for all objects.  Does not allow modifing the
  381.   property but does display the class name of the object and will allow the
  382.   editing of the object's properties as sub-properties of the property. }
  383.  
  384.   TClassProperty = class(TPropertyEditor)
  385.   public
  386.     function GetAttributes: TPropertyAttributes; override;
  387.     procedure GetProperties(Proc: TGetPropEditProc); override;
  388.     function GetValue: string; override;
  389.   end;
  390.  
  391. { TMethodProperty
  392.   Property editor for all method properties. }
  393.  
  394.   TMethodProperty = class(TPropertyEditor)
  395.   public
  396.     function AllEqual: Boolean; override;
  397.     procedure Edit; override;
  398.     function GetAttributes: TPropertyAttributes; override;
  399.     function GetEditLimit: Integer; override;
  400.     function GetValue: string; override;
  401.     procedure GetValues(Proc: TGetStrProc); override;
  402.     procedure SetValue(const AValue: string); override;
  403.   end;
  404.  
  405. { TComponentProperty
  406.   The default editor for TComponents.  It does not allow editing of the
  407.   properties of the component.  It allow the user to set the value of this
  408.   property to point to a component in the same form that is type compatible
  409.   with the property being edited (e.g. the ActiveControl property). }
  410.  
  411.   TComponentProperty = class(TPropertyEditor)
  412.   public
  413.     function GetAttributes: TPropertyAttributes; override;
  414.     function GetEditLimit: Integer; override;
  415.     function GetValue: string; override;
  416.     procedure GetValues(Proc: TGetStrProc); override;
  417.     procedure SetValue(const Value: string); override;
  418.   end;
  419.  
  420. { TComponentNameProperty
  421.   Property editor for the Name property.  It restricts the name property
  422.   from being displayed when more than one component is selected. }
  423.  
  424.   TComponentNameProperty = class(TStringProperty)
  425.   public
  426.     function GetAttributes: TPropertyAttributes; override;
  427.     function GetEditLimit: Integer; override;
  428.   end;
  429.  
  430. { TFontNameProperty
  431.   Editor for the TFont.FontName property.  Displays a drop-down list of all
  432.   the fonts known by Windows.}
  433.  
  434.   TFontNameProperty = class(TStringProperty)
  435.   public
  436.     function GetAttributes: TPropertyAttributes; override;
  437.     procedure GetValues(Proc: TGetStrProc); override;
  438.   end;
  439.  
  440. { TFontCharsetProperty
  441.   Editor for the TFont.Charset property.  Displays a drop-down list of the
  442.   character-set by Windows.}
  443.  
  444.   TFontCharsetProperty = class(TIntegerProperty)
  445.   public
  446.     function GetAttributes: TPropertyAttributes; override;
  447.     function GetValue: string; override;
  448.     procedure GetValues(Proc: TGetStrProc); override;
  449.     procedure SetValue(const Value: string); override;
  450.   end;
  451.  
  452. { TImeNameProperty
  453.   Editor for the TImeName property.  Displays a drop-down list of all
  454.   the IME names known by Windows.}
  455.  
  456.   TImeNameProperty = class(TStringProperty)
  457.   public
  458.     function GetAttributes: TPropertyAttributes; override;
  459.     procedure GetValues(Proc: TGetStrProc); override;
  460.   end;
  461.  
  462. { TColorProperty
  463.   Property editor for the TColor type.  Displays the color as a clXXX value
  464.   if one exists, otherwise displays the value as hex.  Also allows the
  465.   clXXX value to be picked from a list. }
  466.  
  467.   TColorProperty = class(TIntegerProperty)
  468.   public
  469.     procedure Edit; override;
  470.     function GetAttributes: TPropertyAttributes; override;
  471.     function GetValue: string; override;
  472.     procedure GetValues(Proc: TGetStrProc); override;
  473.     procedure SetValue(const Value: string); override;
  474.   end;
  475.  
  476. { TCursorProperty
  477.   Property editor for the TCursor type.  Displays the color as a crXXX value
  478.   if one exists, otherwise displays the value as hex.  Also allows the
  479.   clXXX value to be picked from a list. }
  480.  
  481.   TCursorProperty = class(TIntegerProperty)
  482.   public
  483.     function GetAttributes: TPropertyAttributes; override;
  484.     function GetValue: string; override;
  485.     procedure GetValues(Proc: TGetStrProc); override;
  486.     procedure SetValue(const Value: string); override;
  487.   end;
  488.  
  489. { TFontProperty
  490.   Property editor the Font property.  Brings up the font dialog as well as
  491.   allowing the properties of the object to be edited. }
  492.  
  493.   TFontProperty = class(TClassProperty)
  494.   public
  495.     procedure Edit; override;
  496.     function GetAttributes: TPropertyAttributes; override;
  497.   end;
  498.  
  499. { TModalResultProperty }
  500.  
  501.   TModalResultProperty = class(TIntegerProperty)
  502.   public
  503.     function GetAttributes: TPropertyAttributes; override;
  504.     function GetValue: string; override;
  505.     procedure GetValues(Proc: TGetStrProc); override;
  506.     procedure SetValue(const Value: string); override;
  507.   end;
  508.  
  509. { TShortCutProperty
  510.   Property editor the the ShortCut property.  Allows both typing in a short
  511.   cut value or picking a short-cut value from a list. }
  512.  
  513.   TShortCutProperty = class(TOrdinalProperty)
  514.   public
  515.     function GetAttributes: TPropertyAttributes; override;
  516.     function GetValue: string; override;
  517.     procedure GetValues(Proc: TGetStrProc); override;
  518.     procedure SetValue(const Value: string); override;
  519.   end;
  520.  
  521. { TMPFilenameProperty
  522.   Property editor for the TMediaPlayer.  Displays an File Open Dialog
  523.   for the name of the media file.}
  524.  
  525.   TMPFilenameProperty = class(TStringProperty)
  526.   public
  527.     procedure Edit; override;
  528.     function GetAttributes: TPropertyAttributes; override;
  529.   end;
  530.  
  531. { TTabOrderProperty
  532.   Property editor for the TabOrder property.  Prevents the property from being
  533.   displayed when more than one component is selected. }
  534.  
  535.   TTabOrderProperty = class(TIntegerProperty)
  536.   public
  537.     function GetAttributes: TPropertyAttributes; override;
  538.   end;
  539.  
  540. { TCaptionProperty
  541.   Property editor for the Caption and Text properties.  Updates the value of
  542.   the property for each change instead on when the property is approved. }
  543.  
  544.   TCaptionProperty = class(TStringProperty)
  545.   public
  546.     function GetAttributes: TPropertyAttributes; override;
  547.   end;
  548.  
  549. { TDateProperty
  550.   Property editor for date portion of TDateTime type. }
  551.  
  552.   TDateProperty = class(TPropertyEditor)
  553.     function GetAttributes: TPropertyAttributes; override;
  554.     function GetValue: string; override;
  555.     procedure SetValue(const Value: string); override;
  556.   end;
  557.  
  558. { TTimeProperty
  559.   Property editor for time portion of TDateTime type. }
  560.  
  561.   TTimeProperty = class(TPropertyEditor)
  562.     function GetAttributes: TPropertyAttributes; override;
  563.     function GetValue: string; override;
  564.     procedure SetValue(const Value: string); override;
  565.   end;
  566.  
  567.   EPropertyError = class(Exception);
  568.  
  569. { TComponentEditor
  570.   A component editor is created for each component that is selected in the
  571.   form designer based on the component's type (see GetComponentEditor and
  572.   RegisterComponentEditor).  When the component is double-clicked the Edit
  573.   method is called.  When the context menu for the component is invoked the
  574.   GetVerbCount and GetVerb methods are called to build the menu.  If one
  575.   of the verbs are selected ExecuteVerb is called.  Paste is called whenever
  576.   the component is pasted to the clipboard.  You only need to create a
  577.   component editor if you wish to add verbs to the context menu, change
  578.   the default double-click behavior, or paste an additional clipboard format.
  579.   The default component editor (TDefaultEditor) implements Edit to searchs the
  580.   properties of the component and generates (or navigates to) the OnCreate,
  581.   OnChanged, or OnClick event (whichever it finds first).  Whenever the
  582.   component modifies the component is *must* call Designer.Modified to inform
  583.   the designer that the form has been modified.
  584.  
  585.     Create(AComponent, ADesigner)
  586.       Called to create the component editor.  AComponent is the component to
  587.       be edited by the editor.  ADesigner is an interface to the designer to
  588.       find controls and create methods (this is not use often).
  589.     Edit
  590.       Called when the user double-clicks the component. The component editor can
  591.       bring up a dialog in responce to this method, for example, or some kind
  592.       of design expert.  If GetVerbCount is greater than zero, edit will execute
  593.       the first verb in the list (ExecuteVerb(0)).
  594.     ExecuteVerb(Index)
  595.       The Index'ed verb was selected by the use off the context menu.  The
  596.       meaning of this is determined by component editor.
  597.     GetVerb
  598.       The component editor should return a string that will be displayed in the
  599.       context menu.  It is the responsibility of the component editor to place
  600.       the & character and the '...' characters as appropriate.
  601.     GetVerbCount
  602.       The number of valid indexs to GetVerb and Execute verb.  The index assumed
  603.       to be zero based (i.e. 0..GetVerbCount - 1).
  604.     Copy
  605.       Called when the component is being copyied to the clipboard.  The
  606.       component's filed image is already on the clipboard.  This gives the
  607.       component editor a chance to paste a different type of format which is
  608.       ignored by the designer but might be recoginized by another application. }
  609.  
  610.   TComponentEditor = class
  611.   private
  612.     FComponent: TComponent;
  613.     FDesigner: TFormDesigner;
  614.   public
  615.     constructor Create(AComponent: TComponent; ADesigner: TFormDesigner); virtual;
  616.     procedure Edit; virtual;
  617.     procedure ExecuteVerb(Index: Integer); virtual;
  618.     function GetVerb(Index: Integer): string; virtual;
  619.     function GetVerbCount: Integer; virtual;
  620.     procedure Copy; virtual;
  621.     property Component: TComponent read FComponent;
  622.     property Designer: TFormDesigner read FDesigner;
  623.   end;
  624.  
  625.   TComponentEditorClass = class of TComponentEditor;
  626.  
  627.   TDefaultEditor = class(TComponentEditor)
  628.   private
  629.     FFirst: TPropertyEditor;
  630.     FBest: TPropertyEditor;
  631.     FContinue: Boolean;
  632.     procedure CheckEdit(PropertyEditor: TPropertyEditor);
  633.   protected
  634.     procedure EditProperty(PropertyEditor: TPropertyEditor;
  635.       var Continue, FreeEditor: Boolean); virtual;
  636.   public
  637.     procedure Edit; override;
  638.   end;
  639.  
  640. { Global variables intialialized internally by the form designer }
  641.  
  642. type
  643.   TFreeCustomModulesProc = procedure (Group: Integer);
  644.  
  645. var
  646.   FreeCustomModulesProc: TFreeCustomModulesProc;
  647.  
  648. { RegisterPropertyEditor
  649.   Registers a new property editor for the given type.  When a component is
  650.   selected the Object Inspector will create a property editor for each
  651.   of the component's properties.  The property editor is created based on
  652.   the type of the property.  If, for example, the property type is an
  653.   Integer, the property editor for Integer will be created (by default
  654.   that would be TIntegerProperty). Most properties do not need specialized
  655.   property editors.  For example, if the property is an ordinal type the
  656.   default property editor will restrict the range to the ordinal subtype
  657.   range (e.g. a property of type TMyRange = 1..10 will only allow values
  658.   between 1 and 10 to be entered into the property).  Enumerated types will
  659.   display a drop-down list of all the enumerated values (e.g. TShapes =
  660.   (sCircle, sSquare, sTriangle) will be edited by a drop-down list containing
  661.   only sCircle, sSquare and sTriangle).  A property editor need only be
  662.   created if default property editor or none of the existing property editors
  663.   are sufficient to edit the property.  This is typically because the
  664.   property is an object.  The properties are looked up newest to oldest.
  665.   This allows and existing property editor replaced by a custom property
  666.   editor.
  667.  
  668.     PropertyType
  669.       The type information pointer returned by the TypeInfo built-in function
  670.       (e.g. TypeInfo(TMyRange) or TypeInfo(TShapes)).
  671.  
  672.     ComponentClass
  673.       Type type of the component to which to restrict this type editor.  This
  674.       parameter can be left nil which will mean this type editor applies to all
  675.       properties of PropertyType.
  676.  
  677.     PropertyName
  678.       The name of the property to which to restrict this type editor.  This
  679.       parameter is ignored if ComponentClass is nil.  This paramter can be
  680.       an empty string ('') which will mean that this editor applies to all
  681.       properties of PropertyType in ComponentClass.
  682.  
  683.     EditorClass
  684.       The class of the editor to be created whenever a property of the type
  685.       passed in PropertyTypeInfo is displayed in the Object Inspector.  The
  686.       class will be created by calling EditorClass.Create. }
  687.  
  688. procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  689.   const PropertyName: string; EditorClass: TPropertyEditorClass);
  690.  
  691. type
  692.   TPropertyMapperFunc = function(Obj: TPersistent;
  693.     PropInfo: PPropInfo): TPropertyEditorClass;
  694.     
  695. procedure RegisterPropertyMapper(Mapper: TPropertyMapperFunc);
  696.  
  697. procedure GetComponentProperties(Components: TComponentList;
  698.   Filter: TTypeKinds; Designer: TFormDesigner; Proc: TGetPropEditProc);
  699.  
  700. procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  701.   ComponentEditor: TComponentEditorClass);
  702.  
  703. function GetComponentEditor(Component: TComponent;
  704.   Designer: TFormDesigner): TComponentEditor;
  705.  
  706. { Custom modules }
  707. { A custom module allows containers that descend from classes other than TForm
  708.   to be created and edited by the form designer. This is useful for other form
  709.   like containers (e.g. a report designer) or for specialized forms (e.g. an
  710.   ActiveForm) or for generic component containers (e.g. a TDataModule). It is
  711.   assumed that the base class registered will call InitInheritedComponent in its
  712.   constructor which will initialize the component from the associated DFM file
  713.   stored in the programs resources. See the constructors of TDataModule and
  714.   TForm for examples of how to write such a constructor.
  715.  
  716.   The following designer assumptions are made, depending on the base components
  717.   ancestor,
  718.  
  719.     If ComponentBaseClass descends from TForm,
  720.  
  721.        it is designed by creating an instance of the component as the form.
  722.        Allows designing TForm descendents and modifying their properties as
  723.        well as the form properties
  724.  
  725.     If ComponentBaseClass descends from TWinControl (but not TForm),
  726.  
  727.        it is designed by creating an instance of the control, placing it into a
  728.        design-time form.  The form's client size is in the default size of the
  729.        control.
  730.  
  731.     If ComponentBaseClass descends from TDataModule,
  732.  
  733.        it is designed by creating and instance of the class and creating a
  734.        special non-visual container designer to edit the components and display
  735.        the icons of the contained components.
  736.  
  737.   The module will appear in the project file with a colon and the base class
  738.   name appended after the component name (e.g. MyDataModle: TDataModule).
  739.  
  740.   Note it is not legal to register anything that does not desend from one of
  741.   the above.
  742.  
  743.   TCustomModule class
  744.     This an instance of this class is created for each custom module that is
  745.     loaded. This class is also destroyed whenever the module is unloaded.
  746.     The Saving method is called prior to the file being saved. When the context
  747.     menu for the module is invoked the GetVerbCount and GetVerb methods are
  748.     called to build the menu.  If one of the verbs are selected ExecuteVerb is
  749.     called.
  750.  
  751.     ExecuteVerb(Index)
  752.       The Index'ed verb was selected by the use off the context menu.  The
  753.       meaning of this is determined by custom module.
  754.     GetAttributes
  755.       Only used for TWinControl object to determine if the control is "client
  756.       aligned" in the designer or if the object should sized independently
  757.       from the designer.  This is a set for future expansion.
  758.     GetVerb(Index)
  759.       The custom module should return a string that will be displayed in the
  760.       context menu.  It is the responsibility of the custom module to place
  761.       the & character and the '...' characters as appropriate.
  762.     GetVerbCount
  763.       The number of valid indexs to GetVerb and Execute verb.  The index assumed
  764.       to be zero based (i.e. 0..GetVerbCount - 1).
  765.     Saving
  766.       Called prior to the module being saved.
  767.     ValidateComponent(Component)
  768.       ValidateCompoennt is called whenever a component is created by the
  769.       user for the designer to contain.  The intent is for this procedure to
  770.       raise an exception with a descriptive message if the component is not
  771.       applicable for the container. For example, a TComponent module should
  772.       throw an exception if the component descends from TControl.
  773.     Root
  774.       This is the instance being designed.}
  775.  
  776. type
  777.   TCustomModuleAttribute = (cmaVirtualSize);
  778.   TCustomModuleAttributes = set of TCustomModuleAttribute;
  779.  
  780.   TCustomModule = class
  781.   private
  782.     FRoot: TComponent;
  783.   public
  784.     constructor Create(ARoot: TComponent); virtual;
  785.     procedure ExecuteVerb(Index: Integer); virtual;
  786.     function GetAttributes: TCustomModuleAttributes; virtual;
  787.     function GetVerb(Index: Integer): string; virtual;
  788.     function GetVerbCount: Integer; virtual;
  789.     procedure Saving; virtual;
  790.     procedure ValidateComponent(Component: TComponent); virtual;
  791.     property Root: TComponent read FRoot;
  792.   end;
  793.  
  794.   TCustomModuleClass = class of TCustomModule;
  795.  
  796.   TRegisterCustomModuleProc = procedure (Group: Integer;
  797.     ComponentBaseClass: TComponentClass;
  798.     CustomModuleClass: TCustomModuleClass);
  799.  
  800. procedure RegisterCustomModule(ComponentBaseClass: TComponentClass;
  801.   CustomModuleClass: TCustomModuleClass);
  802.  
  803. var
  804.   RegisterCustomModuleProc: TRegisterCustomModuleProc;
  805.  
  806. { Routines used by the form designer for package management }
  807.  
  808. function NewEditorGroup: Integer;
  809. procedure FreeEditorGroup(Group: Integer);
  810.  
  811. implementation
  812.  
  813. uses Windows, Menus, Dialogs, Consts, IniFiles;
  814.  
  815. type
  816.   TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;
  817.  
  818. type
  819.   PPropertyClassRec = ^TPropertyClassRec;
  820.   TPropertyClassRec = record
  821.     Group: Integer;
  822.     PropertyType: PTypeInfo;
  823.     PropertyName: string;
  824.     ComponentClass: TClass;
  825.     EditorClass: TPropertyEditorClass;
  826.   end;
  827.  
  828. type
  829.   PPropertyMapperRec = ^TPropertyMapperRec;
  830.   TPropertyMapperRec = record
  831.     Group: Integer;
  832.     Mapper: TPropertyMapperFunc;
  833.   end;
  834.  
  835. const
  836.   PropClassMap: array[TTypeKind] of TPropertyEditorClass = (
  837.     nil, TIntegerProperty, TCharProperty, TEnumProperty,
  838.     TFloatProperty, TStringProperty, TSetProperty, TClassProperty,
  839.     TMethodProperty, TPropertyEditor, TStringProperty, TStringProperty,
  840.     TPropertyEditor, nil, nil, nil); (* tkInterface, tkArray, tkRecord *)
  841.  
  842. var
  843.   PropertyClassList: TList = nil;
  844.   EditorGroupList: TBits = nil;
  845.   PropertyMapperList: TList = nil;
  846.  
  847. const
  848.  
  849.   { context ids for the Font editor and the Color Editor, etc. }
  850.   hcDFontEditor       = 25000;
  851.   hcDColorEditor      = 25010;
  852.   hcDMediaPlayerOpen  = 25020;
  853.  
  854. { TComponentList }
  855.  
  856. constructor TComponentList.Create;
  857. begin
  858.   inherited Create;
  859.   FList := TList.Create;
  860. end;
  861.  
  862. destructor TComponentList.Destroy;
  863. begin
  864.   FList.Free;
  865.   inherited Destroy;
  866. end;
  867.  
  868. function TComponentList.Get(Index: Integer): TPersistent;
  869. begin
  870.   Result := FList[Index];
  871. end;
  872.  
  873. function TComponentList.GetCount: Integer;
  874. begin
  875.   Result := FList.Count;
  876. end;
  877.  
  878. function TComponentList.Add(Item: TPersistent): Integer;
  879. begin
  880.   Result := FList.Add(Item);
  881. end;
  882.  
  883. function TComponentList.Equals(List: TComponentList): Boolean;
  884. var
  885.   I: Integer;
  886. begin
  887.   Result := False;
  888.   if List.Count <> FList.Count then Exit;
  889.   for I := 0 to List.Count - 1 do if List[I] <> FList[I] then Exit;
  890.   Result := True;
  891. end;
  892.  
  893. { TPropertyEditor }
  894.  
  895. constructor TPropertyEditor.Create(ADesigner: TFormDesigner;
  896.   APropCount: Integer);
  897. begin
  898.   FDesigner := ADesigner;
  899.   GetMem(FPropList, APropCount * SizeOf(TInstProp));
  900.   FPropCount := APropCount;
  901. end;
  902.  
  903. destructor TPropertyEditor.Destroy;
  904. begin
  905.   if FPropList <> nil then
  906.     FreeMem(FPropList, FPropCount * SizeOf(TInstProp));
  907. end;
  908.  
  909. procedure TPropertyEditor.Activate;
  910. begin
  911. end;
  912.  
  913. function TPropertyEditor.AllEqual: Boolean;
  914. begin
  915.   Result := FPropCount = 1;
  916. end;
  917.  
  918. procedure TPropertyEditor.Edit;
  919. type
  920.   TGetStrFunc = function(const Value: string): Integer of object;
  921. var
  922.   I: Integer;
  923.   Values: TStringList;
  924.   AddValue: TGetStrFunc;
  925. begin
  926.   Values := TStringList.Create;
  927.   Values.Sorted := paSortList in GetAttributes;
  928.   try
  929.     AddValue := Values.Add;
  930.     GetValues(TGetStrProc(AddValue));
  931.     if Values.Count > 0 then
  932.     begin
  933.       I := Values.IndexOf(Value) + 1;
  934.       if I = Values.Count then I := 0;
  935.       Value := Values[I];
  936.     end;
  937.   finally
  938.     Values.Free;
  939.   end;
  940. end;
  941.  
  942. function TPropertyEditor.GetAttributes: TPropertyAttributes;
  943. begin
  944.   Result := [paMultiSelect, paRevertable];
  945. end;
  946.  
  947. function TPropertyEditor.GetComponent(Index: Integer): TPersistent;
  948. begin
  949.   Result := FPropList^[Index].Instance;
  950. end;
  951.  
  952. function TPropertyEditor.GetFloatValue: Extended;
  953. begin
  954.   Result := GetFloatValueAt(0);
  955. end;
  956.  
  957. function TPropertyEditor.GetFloatValueAt(Index: Integer): Extended;
  958. begin
  959.   with FPropList^[Index] do Result := GetFloatProp(Instance, PropInfo);
  960. end;
  961.  
  962. function TPropertyEditor.GetMethodValue: TMethod;
  963. begin
  964.   Result := GetMethodValueAt(0);
  965. end;
  966.  
  967. function TPropertyEditor.GetMethodValueAt(Index: Integer): TMethod;
  968. begin
  969.   with FPropList^[Index] do Result := GetMethodProp(Instance, PropInfo);
  970. end;
  971.  
  972. function TPropertyEditor.GetEditLimit: Integer;
  973. begin
  974.   Result := 255;
  975. end;
  976.  
  977. function TPropertyEditor.GetName: string;
  978. begin
  979.   Result := FPropList^[0].PropInfo^.Name;
  980. end;
  981.  
  982. function TPropertyEditor.GetOrdValue: Longint;
  983. begin
  984.   Result := GetOrdValueAt(0);
  985. end;
  986.  
  987. function TPropertyEditor.GetOrdValueAt(Index: Integer): Longint;
  988. begin
  989.   with FPropList^[Index] do Result := GetOrdProp(Instance, PropInfo);
  990. end;
  991.  
  992. function TPropertyEditor.GetPrivateDirectory: string;
  993. begin
  994.   Result := Designer.GetPrivateDirectory;
  995. end;
  996.  
  997. procedure TPropertyEditor.GetProperties(Proc: TGetPropEditProc);
  998. begin
  999. end;
  1000.  
  1001. function TPropertyEditor.GetPropInfo: PPropInfo;
  1002. begin
  1003.   Result := FPropList^[0].PropInfo;
  1004. end;
  1005.  
  1006. function TPropertyEditor.GetPropType: PTypeInfo;
  1007. begin
  1008.   Result := FPropList^[0].PropInfo^.PropType^;
  1009. end;
  1010.  
  1011. function TPropertyEditor.GetStrValue: string;
  1012. begin
  1013.   Result := GetStrValueAt(0);
  1014. end;
  1015.  
  1016. function TPropertyEditor.GetStrValueAt(Index: Integer): string;
  1017. begin
  1018.   with FPropList^[Index] do Result := GetStrProp(Instance, PropInfo);
  1019. end;
  1020.  
  1021. function TPropertyEditor.GetVarValue: Variant;
  1022. begin
  1023.   Result := GetVarValueAt(0);
  1024. end;
  1025.  
  1026. function TPropertyEditor.GetVarValueAt(Index: Integer): Variant;
  1027. begin
  1028.   with FPropList^[Index] do Result := GetVariantProp(Instance, PropInfo);
  1029. end;
  1030.  
  1031. function TPropertyEditor.GetValue: string;
  1032. begin
  1033.   Result := srUnknown;
  1034. end;
  1035.  
  1036. procedure TPropertyEditor.GetValues(Proc: TGetStrProc);
  1037. begin
  1038. end;
  1039.  
  1040. procedure TPropertyEditor.Initialize;
  1041. begin
  1042. end;
  1043.  
  1044. procedure TPropertyEditor.Modified;
  1045. begin
  1046.   Designer.Modified;
  1047. end;
  1048.  
  1049. procedure TPropertyEditor.SetFloatValue(Value: Extended);
  1050. var
  1051.   I: Integer;
  1052. begin
  1053.   for I := 0 to FPropCount - 1 do
  1054.     with FPropList^[I] do SetFloatProp(Instance, PropInfo, Value);
  1055.   Modified;
  1056. end;
  1057.  
  1058. procedure TPropertyEditor.SetMethodValue(const Value: TMethod);
  1059. var
  1060.   I: Integer;
  1061. begin
  1062.   for I := 0 to FPropCount - 1 do
  1063.     with FPropList^[I] do SetMethodProp(Instance, PropInfo, Value);
  1064.   Modified;
  1065. end;
  1066.  
  1067. procedure TPropertyEditor.SetOrdValue(Value: Longint);
  1068. var
  1069.   I: Integer;
  1070. begin
  1071.   for I := 0 to FPropCount - 1 do
  1072.     with FPropList^[I] do SetOrdProp(Instance, PropInfo, Value);
  1073.   Modified;
  1074. end;
  1075.  
  1076. procedure TPropertyEditor.SetPropEntry(Index: Integer;
  1077.   AInstance: TPersistent; APropInfo: PPropInfo);
  1078. begin
  1079.   with FPropList^[Index] do
  1080.   begin
  1081.     Instance := AInstance;
  1082.     PropInfo := APropInfo;
  1083.   end;
  1084. end;
  1085.  
  1086. procedure TPropertyEditor.SetStrValue(const Value: string);
  1087. var
  1088.   I: Integer;
  1089. begin
  1090.   for I := 0 to FPropCount - 1 do
  1091.     with FPropList^[I] do SetStrProp(Instance, PropInfo, Value);
  1092.   Modified;
  1093. end;
  1094.  
  1095. procedure TPropertyEditor.SetVarValue(const Value: Variant);
  1096. var
  1097.   I: Integer;
  1098. begin
  1099.   for I := 0 to FPropCount - 1 do
  1100.     with FPropList^[I] do SetVariantProp(Instance, PropInfo, Value);
  1101.   Modified;
  1102. end;
  1103.  
  1104. procedure TPropertyEditor.Revert;
  1105. var
  1106.   I: Integer;
  1107. begin
  1108.   for I := 0 to FPropCount - 1 do
  1109.     with FPropList^[I] do Designer.Revert(Instance, PropInfo);
  1110. end;
  1111.  
  1112. procedure TPropertyEditor.SetValue(const Value: string);
  1113. begin
  1114. end;
  1115.  
  1116. function TPropertyEditor.ValueAvailable: Boolean;
  1117. var
  1118.   I: Integer;
  1119.   S: string;
  1120. begin
  1121.   Result := True;
  1122.   for I := 0 to FPropCount - 1 do
  1123.   begin
  1124.     if (FPropList^[I].Instance is TComponent) and
  1125.       (csCheckPropAvail in TComponent(FPropList^[I].Instance).ComponentStyle) then
  1126.     begin
  1127.       try
  1128.         S := GetValue;
  1129.         AllEqual;
  1130.       except
  1131.         Result := False;
  1132.       end;
  1133.       Exit;
  1134.     end;
  1135.   end;
  1136. end;
  1137.  
  1138. { TOrdinalProperty }
  1139.  
  1140. function TOrdinalProperty.AllEqual: Boolean;
  1141. var
  1142.   I: Integer;
  1143.   V: Longint;
  1144. begin
  1145.   Result := False;
  1146.   if PropCount > 1 then
  1147.   begin
  1148.     V := GetOrdValue;
  1149.     for I := 1 to PropCount - 1 do
  1150.       if GetOrdValueAt(I) <> V then Exit;
  1151.   end;
  1152.   Result := True;
  1153. end;
  1154.  
  1155. function TOrdinalProperty.GetEditLimit: Integer;
  1156. begin
  1157.   Result := 63;
  1158. end;
  1159.  
  1160. { TIntegerProperty }
  1161.  
  1162. function TIntegerProperty.GetValue: string;
  1163. begin
  1164.   Result := IntToStr(GetOrdValue);
  1165. end;
  1166.  
  1167. procedure TIntegerProperty.SetValue(const Value: String);
  1168. var
  1169.   L: Longint;
  1170. begin
  1171.   L := StrToInt(Value);
  1172.   with GetTypeData(GetPropType)^ do
  1173.     if (L < MinValue) or (L > MaxValue) then
  1174.       raise EPropertyError.CreateFmt(SOutOfRange, [MinValue, MaxValue]);
  1175.   SetOrdValue(L);
  1176. end;
  1177.  
  1178. { TCharProperty }
  1179.  
  1180. function TCharProperty.GetValue: string;
  1181. var
  1182.   Ch: Char;
  1183. begin
  1184.   Ch := Chr(GetOrdValue);
  1185.   if Ch in [#33..#127] then
  1186.     Result := Ch else
  1187.     FmtStr(Result, '#%d', [Ord(Ch)]);
  1188. end;
  1189.  
  1190. procedure TCharProperty.SetValue(const Value: string);
  1191. var
  1192.   L: Longint;
  1193. begin
  1194.   if Length(Value) = 0 then L := 0 else
  1195.     if Length(Value) = 1 then L := Ord(Value[1]) else
  1196.       if Value[1] = '#' then L := StrToInt(Copy(Value, 2, Maxint)) else
  1197.         raise EPropertyError.Create(SInvalidPropertyValue);
  1198.   with GetTypeData(GetPropType)^ do
  1199.     if (L < MinValue) or (L > MaxValue) then
  1200.       raise EPropertyError.CreateFmt(SOutOfRange, [MinValue, MaxValue]);
  1201.   SetOrdValue(L);
  1202. end;
  1203.  
  1204. { TEnumProperty }
  1205.  
  1206. function TEnumProperty.GetAttributes: TPropertyAttributes;
  1207. begin
  1208.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1209. end;
  1210.  
  1211. function TEnumProperty.GetValue: string;
  1212. var
  1213.   L: Longint;
  1214. begin
  1215.   L := GetOrdValue;
  1216.   with GetTypeData(GetPropType)^ do
  1217.     if (L < MinValue) or (L > MaxValue) then L := MaxValue;
  1218.   Result := GetEnumName(GetPropType, L);
  1219. end;
  1220.  
  1221. procedure TEnumProperty.GetValues(Proc: TGetStrProc);
  1222. var
  1223.   I: Integer;
  1224.   EnumType: PTypeInfo;
  1225. begin
  1226.   EnumType := GetPropType;
  1227.   with GetTypeData(EnumType)^ do
  1228.     for I := MinValue to MaxValue do Proc(GetEnumName(EnumType, I));
  1229. end;
  1230.  
  1231. procedure TEnumProperty.SetValue(const Value: string);
  1232. var
  1233.   I: Integer;
  1234. begin
  1235.   I := GetEnumValue(GetPropType, Value);
  1236.   if I < 0 then raise EPropertyError.Create(SInvalidPropertyValue);
  1237.   SetOrdValue(I);
  1238. end;
  1239.  
  1240. { TBoolProperty  }
  1241.  
  1242. function TBoolProperty.GetValue: string;
  1243. begin
  1244.   if GetOrdValue = 0 then
  1245.     Result := 'False'
  1246.   else
  1247.     Result := 'True';
  1248. end;
  1249.  
  1250. procedure TBoolProperty.GetValues(Proc: TGetStrProc);
  1251. begin
  1252.   Proc('False');
  1253.   Proc('True');
  1254. end;
  1255.  
  1256. procedure TBoolProperty.SetValue(const Value: string);
  1257. var
  1258.   I: Integer;
  1259. begin
  1260.   if CompareText(Value, 'False') = 0 then
  1261.     I := 0
  1262.   else if CompareText(Value, 'True') = 0 then
  1263.     I := -1
  1264.   else
  1265.     I := StrToInt(Value);
  1266.   SetOrdValue(I);
  1267. end;
  1268.  
  1269. { TFloatProperty }
  1270.  
  1271. function TFloatProperty.AllEqual: Boolean;
  1272. var
  1273.   I: Integer;
  1274.   V: Extended;
  1275. begin
  1276.   Result := False;
  1277.   if PropCount > 1 then
  1278.   begin
  1279.     V := GetFloatValue;
  1280.     for I := 1 to PropCount - 1 do
  1281.       if GetFloatValueAt(I) <> V then Exit;
  1282.   end;
  1283.   Result := True;
  1284. end;
  1285.  
  1286. function TFloatProperty.GetValue: string;
  1287. const
  1288.   Precisions: array[TFloatType] of Integer = (7, 15, 18, 18, 18);
  1289. begin
  1290.   Result := FloatToStrF(GetFloatValue, ffGeneral,
  1291.     Precisions[GetTypeData(GetPropType)^.FloatType], 0);
  1292. end;
  1293.  
  1294. procedure TFloatProperty.SetValue(const Value: string);
  1295. begin
  1296.   SetFloatValue(StrToFloat(Value));
  1297. end;
  1298.  
  1299. { TStringProperty }
  1300.  
  1301. function TStringProperty.AllEqual: Boolean;
  1302. var
  1303.   I: Integer;
  1304.   V: string;
  1305. begin
  1306.   Result := False;
  1307.   if PropCount > 1 then
  1308.   begin
  1309.     V := GetStrValue;
  1310.     for I := 1 to PropCount - 1 do
  1311.       if GetStrValueAt(I) <> V then Exit;
  1312.   end;
  1313.   Result := True;
  1314. end;
  1315.  
  1316. function TStringProperty.GetEditLimit: Integer;
  1317. begin
  1318.   if GetPropType^.Kind = tkString then
  1319.     Result := GetTypeData(GetPropType)^.MaxLength else
  1320.     Result := 255;
  1321. end;
  1322.  
  1323. function TStringProperty.GetValue: string;
  1324. begin
  1325.   Result := GetStrValue;
  1326. end;
  1327.  
  1328. procedure TStringProperty.SetValue(const Value: string);
  1329. begin
  1330.   SetStrValue(Value);
  1331. end;
  1332.  
  1333. { TComponentNameProperty }
  1334.  
  1335. function TComponentNameProperty.GetAttributes: TPropertyAttributes;
  1336. begin
  1337.   Result := [];
  1338. end;
  1339.  
  1340. function TComponentNameProperty.GetEditLimit: Integer;
  1341. begin
  1342.   Result := 63;
  1343. end;
  1344.  
  1345. { TSetElementProperty }
  1346.  
  1347. constructor TSetElementProperty.Create(ADesigner: TFormDesigner;
  1348.   APropList: PInstPropList; APropCount: Integer; AElement: Integer);
  1349. begin
  1350.   FDesigner := ADesigner;
  1351.   FPropList := APropList;
  1352.   FPropCount := APropCount;
  1353.   FElement := AElement;
  1354. end;
  1355.  
  1356. destructor TSetElementProperty.Destroy;
  1357. begin
  1358. end;
  1359.  
  1360. function TSetElementProperty.AllEqual: Boolean;
  1361. var
  1362.   I: Integer;
  1363.   S: TIntegerSet;
  1364.   V: Boolean;
  1365. begin
  1366.   Result := False;
  1367.   if PropCount > 1 then
  1368.   begin
  1369.     Integer(S) := GetOrdValue;
  1370.     V := FElement in S;
  1371.     for I := 1 to PropCount - 1 do
  1372.     begin
  1373.       Integer(S) := GetOrdValueAt(I);
  1374.       if (FElement in S) <> V then Exit;
  1375.     end;
  1376.   end;
  1377.   Result := True;
  1378. end;
  1379.  
  1380. function TSetElementProperty.GetAttributes: TPropertyAttributes;
  1381. begin
  1382.   Result := [paMultiSelect, paValueList, paSortList];
  1383. end;
  1384.  
  1385. function TSetElementProperty.GetName: string;
  1386. begin
  1387.   Result := GetEnumName(GetTypeData(GetPropType)^.CompType^, FElement);
  1388. end;
  1389.  
  1390. function TSetElementProperty.GetValue: string;
  1391. var
  1392.   S: TIntegerSet;
  1393. begin
  1394.   Integer(S) := GetOrdValue;
  1395.   if FElement in S then Result := 'True' else Result := 'False';
  1396. end;
  1397.  
  1398. procedure TSetElementProperty.GetValues(Proc: TGetStrProc);
  1399. begin
  1400.   Proc('False');
  1401.   Proc('True');
  1402. end;
  1403.  
  1404. procedure TSetElementProperty.SetValue(const Value: string);
  1405. var
  1406.   S: TIntegerSet;
  1407. begin
  1408.   Integer(S) := GetOrdValue;
  1409.   if CompareText(Value, 'True') = 0 then
  1410.     Include(S, FElement) else
  1411.     Exclude(S, FElement);
  1412.   SetOrdValue(Integer(S));
  1413. end;
  1414.  
  1415. { TSetProperty }
  1416.  
  1417. function TSetProperty.GetAttributes: TPropertyAttributes;
  1418. begin
  1419.   Result := [paMultiSelect, paSubProperties, paReadOnly, paRevertable];
  1420. end;
  1421.  
  1422. procedure TSetProperty.GetProperties(Proc: TGetPropEditProc);
  1423. var
  1424.   I: Integer;
  1425. begin
  1426.   with GetTypeData(GetTypeData(GetPropType)^.CompType^)^ do
  1427.     for I := MinValue to MaxValue do
  1428.       Proc(TSetElementProperty.Create(FDesigner, FPropList, FPropCount, I));
  1429. end;
  1430.  
  1431. function TSetProperty.GetValue: string;
  1432. var
  1433.   S: TIntegerSet;
  1434.   TypeInfo: PTypeInfo;
  1435.   I: Integer;
  1436. begin
  1437.   Integer(S) := GetOrdValue;
  1438.   TypeInfo := GetTypeData(GetPropType)^.CompType^;
  1439.   Result := '[';
  1440.   for I := 0 to SizeOf(Integer) * 8 - 1 do
  1441.     if I in S then
  1442.     begin
  1443.       if Length(Result) <> 1 then Result := Result + ',';
  1444.       Result := Result + GetEnumName(TypeInfo, I);
  1445.     end;
  1446.   Result := Result + ']';
  1447. end;
  1448.  
  1449. { TClassProperty }
  1450.  
  1451. function TClassProperty.GetAttributes: TPropertyAttributes;
  1452. begin
  1453.   Result := [paMultiSelect, paSubProperties, paReadOnly];
  1454. end;
  1455.  
  1456. procedure TClassProperty.GetProperties(Proc: TGetPropEditProc);
  1457. var
  1458.   I: Integer;
  1459.   Components: TComponentList;
  1460. begin
  1461.   Components := TComponentList.Create;
  1462.   try
  1463.     for I := 0 to PropCount - 1 do
  1464.       Components.Add(TComponent(GetOrdValueAt(I)));
  1465.     GetComponentProperties(Components, tkProperties, Designer, Proc);
  1466.   finally
  1467.     Components.Free;
  1468.   end;
  1469. end;
  1470.  
  1471. function TClassProperty.GetValue: string;
  1472. begin
  1473.   FmtStr(Result, '(%s)', [GetPropType^.Name]);
  1474. end;
  1475.  
  1476. { TComponentProperty }
  1477.  
  1478. function TComponentProperty.GetAttributes: TPropertyAttributes;
  1479. begin
  1480.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1481. end;
  1482.  
  1483. function TComponentProperty.GetEditLimit: Integer;
  1484. begin
  1485.   Result := 127;
  1486. end;
  1487.  
  1488. function TComponentProperty.GetValue: string;
  1489. begin
  1490.   Result := Designer.GetComponentName(TComponent(GetOrdValue));
  1491. end;
  1492.  
  1493. procedure TComponentProperty.GetValues(Proc: TGetStrProc);
  1494. begin
  1495.   Designer.GetComponentNames(GetTypeData(GetPropType), Proc);
  1496. end;
  1497.  
  1498. procedure TComponentProperty.SetValue(const Value: string);
  1499. var
  1500.   Component: TComponent;
  1501. begin
  1502.   if Value = '' then Component := nil else
  1503.   begin
  1504.     Component := Designer.GetComponent(Value);
  1505.     if not (Component is GetTypeData(GetPropType)^.ClassType) then
  1506.       raise EPropertyError.Create(SInvalidPropertyValue);
  1507.   end;
  1508.   SetOrdValue(Longint(Component));
  1509. end;
  1510.  
  1511. { TMethodProperty }
  1512.  
  1513. function TMethodProperty.AllEqual: Boolean;
  1514. var
  1515.   I: Integer;
  1516.   V, T: TMethod;
  1517. begin
  1518.   Result := False;
  1519.   if PropCount > 1 then
  1520.   begin
  1521.     V := GetMethodValue;
  1522.     for I := 1 to PropCount - 1 do
  1523.     begin
  1524.       T := GetMethodValueAt(I);
  1525.       if (T.Code <> V.Code) or (T.Data <> V.Data) then Exit;
  1526.     end;
  1527.   end;
  1528.   Result := True;
  1529. end;
  1530.  
  1531. procedure TMethodProperty.Edit;
  1532. var
  1533.   FormMethodName, EventName: string;
  1534.   I: Integer;
  1535. begin
  1536.   FormMethodName := GetValue;
  1537.   if (FormMethodName = '') or
  1538.     Designer.MethodFromAncestor(GetMethodValue) then
  1539.   begin
  1540.     if FormMethodName = '' then
  1541.     begin
  1542.       if GetComponent(0) = Designer.Form then
  1543.         FormMethodName := 'Form'
  1544.       else
  1545.       begin
  1546.         FormMethodName := Designer.GetObjectName(GetComponent(0));
  1547.         for I := Length(FormMethodName) downto 1 do
  1548.           if FormMethodName[I] in ['.','[',']'] then
  1549.             Delete(FormMethodName, I, 1);
  1550.       end;
  1551.       if FormMethodName = '' then
  1552.         raise EPropertyError.Create(SCannotCreateName);
  1553.       EventName := GetName;
  1554.       if (Length(EventName) >= 2) and
  1555.         (EventName[1] in ['O','o']) and (EventName[2] in ['N','n']) then
  1556.         Delete(EventName,1,2);
  1557.       FormMethodName := FormMethodName + EventName;
  1558.     end;
  1559.     SetMethodValue(Designer.CreateMethod(FormMethodName,
  1560.       GetTypeData(GetPropType)));
  1561.   end;
  1562.   Designer.ShowMethod(FormMethodName);
  1563. end;
  1564.  
  1565. function TMethodProperty.GetAttributes: TPropertyAttributes;
  1566. begin
  1567.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1568. end;
  1569.  
  1570. function TMethodProperty.GetEditLimit: Integer;
  1571. begin
  1572.   Result := 63;
  1573. end;
  1574.  
  1575. function TMethodProperty.GetValue: string;
  1576. begin
  1577.   Result := Designer.GetMethodName(GetMethodValue);
  1578. end;
  1579.  
  1580. procedure TMethodProperty.GetValues(Proc: TGetStrProc);
  1581. begin
  1582.   Designer.GetMethods(GetTypeData(GetPropType), Proc);
  1583. end;
  1584.  
  1585. procedure TMethodProperty.SetValue(const AValue: string);
  1586. var
  1587.   NewMethod: Boolean;
  1588.   CurValue: string;
  1589. begin
  1590.   CurValue:= GetValue;
  1591.   if (CurValue <> '') and (AValue <> '') and
  1592.     ((CompareText(CurValue, AValue) = 0) or
  1593.     not Designer.MethodExists(AValue)) then
  1594.     Designer.RenameMethod(CurValue, AValue)
  1595.   else
  1596.   begin
  1597.     NewMethod := (AValue <> '') and not Designer.MethodExists(AValue);
  1598.     SetMethodValue(Designer.CreateMethod(AValue, GetTypeData(GetPropType)));
  1599.     if NewMethod then Designer.ShowMethod(AValue);
  1600.   end;
  1601. end;
  1602.  
  1603. { TFontNameProperty }
  1604.  
  1605. function TFontNameProperty.GetAttributes: TPropertyAttributes;
  1606. begin
  1607.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1608. end;
  1609.  
  1610. procedure TFontNameProperty.GetValues(Proc: TGetStrProc);
  1611. var
  1612.   I: Integer;
  1613. begin
  1614.   for I := 0 to Screen.Fonts.Count - 1 do Proc(Screen.Fonts[I]);
  1615. end;
  1616.  
  1617. { TFontCharsetProperty }
  1618.  
  1619. function TFontCharsetProperty.GetAttributes: TPropertyAttributes;
  1620. begin
  1621.   Result := [paMultiSelect, paSortList, paValueList];
  1622. end;
  1623.  
  1624. function TFontCharsetProperty.GetValue: string;
  1625. begin
  1626.   if not CharsetToIdent(TFontCharset(GetOrdValue), Result) then
  1627.     FmtStr(Result, '%d', [GetOrdValue]);
  1628. end;
  1629.  
  1630. procedure TFontCharsetProperty.GetValues(Proc: TGetStrProc);
  1631. begin
  1632.   GetCharsetValues(Proc);
  1633. end;
  1634.  
  1635. procedure TFontCharsetProperty.SetValue(const Value: string);
  1636. var
  1637.   NewValue: Longint;
  1638. begin
  1639.   if IdentToCharset(Value, NewValue) then
  1640.     SetOrdValue(NewValue)
  1641.   else inherited SetValue(Value);
  1642. end;
  1643.  
  1644. { TImeNameProperty }
  1645.  
  1646. function TImeNameProperty.GetAttributes: TPropertyAttributes;
  1647. begin
  1648.   Result := [paValueList, paSortList, paMultiSelect];
  1649. end;
  1650.  
  1651. procedure TImeNameProperty.GetValues(Proc: TGetStrProc);
  1652. var
  1653.   I: Integer;
  1654. begin
  1655.   for I := 0 to Screen.Imes.Count - 1 do Proc(Screen.Imes[I]);
  1656. end;
  1657.  
  1658. { TMPFilenameProperty }
  1659.  
  1660. procedure TMPFilenameProperty.Edit;
  1661. var
  1662.   MPFileOpen: TOpenDialog;
  1663. begin
  1664.   MPFileOpen := TOpenDialog.Create(Application);
  1665.   MPFileOpen.Filename := GetValue;
  1666.   MPFileOpen.Filter := SMPOpenFilter;
  1667.   MPFileOpen.HelpContext := hcDMediaPlayerOpen;
  1668.   MPFileOpen.Options := MPFileOpen.Options + [ofShowHelp, ofPathMustExist,
  1669.     ofFileMustExist];
  1670.   try
  1671.     if MPFileOpen.Execute then SetValue(MPFileOpen.Filename);
  1672.   finally
  1673.     MPFileOpen.Free;
  1674.   end;
  1675. end;
  1676.  
  1677. function TMPFilenameProperty.GetAttributes: TPropertyAttributes;
  1678. begin
  1679.   Result := [paDialog, paRevertable];
  1680. end;
  1681.  
  1682. { TColorProperty }
  1683.  
  1684. procedure TColorProperty.Edit;
  1685. var
  1686.   ColorDialog: TColorDialog;
  1687.   IniFile: TIniFile;
  1688.  
  1689.   procedure GetCustomColors;
  1690.   begin
  1691.     IniFile := TIniFile.Create('DELPHI32.INI');
  1692.     try
  1693.       IniFile.ReadSectionValues(SCustomColors,
  1694.         ColorDialog.CustomColors);
  1695.     except
  1696.       { Ignore errors reading values }
  1697.     end;
  1698.   end;
  1699.  
  1700.   procedure SaveCustomColors;
  1701.   var
  1702.     I, P: Integer;
  1703.     S: string;
  1704.   begin
  1705.     if IniFile <> nil then
  1706.       with ColorDialog do
  1707.         for I := 0 to CustomColors.Count - 1 do
  1708.         begin
  1709.           S := CustomColors.Strings[I];
  1710.           P := Pos('=', S);
  1711.           if P <> 0 then
  1712.           begin
  1713.             S := Copy(S, 1, P - 1);
  1714.             IniFile.WriteString(SCustomColors, S,
  1715.               CustomColors.Values[S]);
  1716.           end;
  1717.         end;
  1718.   end;
  1719.  
  1720. begin
  1721.   IniFile := nil;
  1722.   ColorDialog := TColorDialog.Create(Application);
  1723.   try
  1724.     GetCustomColors;
  1725.     ColorDialog.Color := GetOrdValue;
  1726.     ColorDialog.HelpContext := hcDColorEditor;
  1727.     ColorDialog.Options := [cdShowHelp];
  1728.     if ColorDialog.Execute then SetOrdValue(ColorDialog.Color);
  1729.     SaveCustomColors;
  1730.   finally
  1731.     if IniFile <> nil then IniFile.Free;
  1732.     ColorDialog.Free;
  1733.   end;
  1734. end;
  1735.  
  1736. function TColorProperty.GetAttributes: TPropertyAttributes;
  1737. begin
  1738.   Result := [paMultiSelect, paDialog, paValueList, paRevertable];
  1739. end;
  1740.  
  1741. function TColorProperty.GetValue: string;
  1742. begin
  1743.   Result := ColorToString(TColor(GetOrdValue));
  1744. end;
  1745.  
  1746. procedure TColorProperty.GetValues(Proc: TGetStrProc);
  1747. begin
  1748.   GetColorValues(Proc);
  1749. end;
  1750.  
  1751. procedure TColorProperty.SetValue(const Value: string);
  1752. var
  1753.   NewValue: Longint;
  1754. begin
  1755.   if IdentToColor(Value, NewValue) then
  1756.     SetOrdValue(NewValue)
  1757.   else inherited SetValue(Value);
  1758. end;
  1759.  
  1760. { TCursorProperty }
  1761.  
  1762. function TCursorProperty.GetAttributes: TPropertyAttributes;
  1763. begin
  1764.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1765. end;
  1766.  
  1767. function TCursorProperty.GetValue: string;
  1768. begin
  1769.   Result := CursorToString(TCursor(GetOrdValue));
  1770. end;
  1771.  
  1772. procedure TCursorProperty.GetValues(Proc: TGetStrProc);
  1773. begin
  1774.   GetCursorValues(Proc);
  1775. end;
  1776.  
  1777. procedure TCursorProperty.SetValue(const Value: string);
  1778. var
  1779.   NewValue: Longint;
  1780. begin
  1781.   if IdentToCursor(Value, NewValue) then
  1782.     SetOrdValue(NewValue)
  1783.   else inherited SetValue(Value);
  1784. end;
  1785.  
  1786. { TFontProperty }
  1787.  
  1788. procedure TFontProperty.Edit;
  1789. var
  1790.   FontDialog: TFontDialog;
  1791. begin
  1792.   FontDialog := TFontDialog.Create(Application);
  1793.   try
  1794.     FontDialog.Font := TFont(GetOrdValue);
  1795.     FontDialog.HelpContext := hcDFontEditor;
  1796.     FontDialog.Options := FontDialog.Options + [fdShowHelp, fdForceFontExist];
  1797.     if FontDialog.Execute then SetOrdValue(Longint(FontDialog.Font));
  1798.   finally
  1799.     FontDialog.Free;
  1800.   end;
  1801. end;
  1802.  
  1803. function TFontProperty.GetAttributes: TPropertyAttributes;
  1804. begin
  1805.   Result := [paMultiSelect, paSubProperties, paDialog, paReadOnly];
  1806. end;
  1807.  
  1808. { TModalResultProperty }
  1809.  
  1810. const
  1811.   ModalResults: array[mrNone..mrYesToAll] of string = (
  1812.     'mrNone',
  1813.     'mrOk',
  1814.     'mrCancel',
  1815.     'mrAbort',
  1816.     'mrRetry',
  1817.     'mrIgnore',
  1818.     'mrYes',
  1819.     'mrNo',
  1820.     'mrAll',
  1821.     'mrNoToAll',
  1822.     'mrYesToAll');
  1823.  
  1824. function TModalResultProperty.GetAttributes: TPropertyAttributes;
  1825. begin
  1826.   Result := [paMultiSelect, paValueList, paRevertable];
  1827. end;
  1828.  
  1829. function TModalResultProperty.GetValue: string;
  1830. var
  1831.   CurValue: Longint;
  1832. begin
  1833.   CurValue := GetOrdValue;
  1834.   case CurValue of
  1835.     Low(ModalResults)..High(ModalResults):
  1836.       Result := ModalResults[CurValue];
  1837.   else
  1838.     Result := IntToStr(CurValue);
  1839.   end;
  1840. end;
  1841.  
  1842. procedure TModalResultProperty.GetValues(Proc: TGetStrProc);
  1843. var
  1844.   I: Integer;
  1845. begin
  1846.   for I := Low(ModalResults) to High(ModalResults) do Proc(ModalResults[I]);
  1847. end;
  1848.  
  1849. procedure TModalResultProperty.SetValue(const Value: string);
  1850. var
  1851.   I: Integer;
  1852. begin
  1853.   if Value = '' then
  1854.   begin
  1855.     SetOrdValue(0);
  1856.     Exit;
  1857.   end;
  1858.   for I := Low(ModalResults) to High(ModalResults) do
  1859.     if CompareText(ModalResults[I], Value) = 0 then
  1860.     begin
  1861.       SetOrdValue(I);
  1862.       Exit;
  1863.     end;
  1864.   inherited SetValue(Value);
  1865. end;
  1866.  
  1867. { TShortCutProperty }
  1868.  
  1869. const
  1870.   ShortCuts: array[0..82] of TShortCut = (
  1871.     scNone,
  1872.     Byte('A') or scCtrl,
  1873.     Byte('B') or scCtrl,
  1874.     Byte('C') or scCtrl,
  1875.     Byte('D') or scCtrl,
  1876.     Byte('E') or scCtrl,
  1877.     Byte('F') or scCtrl,
  1878.     Byte('G') or scCtrl,
  1879.     Byte('H') or scCtrl,
  1880.     Byte('I') or scCtrl,
  1881.     Byte('J') or scCtrl,
  1882.     Byte('K') or scCtrl,
  1883.     Byte('L') or scCtrl,
  1884.     Byte('M') or scCtrl,
  1885.     Byte('N') or scCtrl,
  1886.     Byte('O') or scCtrl,
  1887.     Byte('P') or scCtrl,
  1888.     Byte('Q') or scCtrl,
  1889.     Byte('R') or scCtrl,
  1890.     Byte('S') or scCtrl,
  1891.     Byte('T') or scCtrl,
  1892.     Byte('U') or scCtrl,
  1893.     Byte('V') or scCtrl,
  1894.     Byte('W') or scCtrl,
  1895.     Byte('X') or scCtrl,
  1896.     Byte('Y') or scCtrl,
  1897.     Byte('Z') or scCtrl,
  1898.     VK_F1,
  1899.     VK_F2,
  1900.     VK_F3,
  1901.     VK_F4,
  1902.     VK_F5,
  1903.     VK_F6,
  1904.     VK_F7,
  1905.     VK_F8,
  1906.     VK_F9,
  1907.     VK_F10,
  1908.     VK_F11,
  1909.     VK_F12,
  1910.     VK_F1 or scCtrl,
  1911.     VK_F2 or scCtrl,
  1912.     VK_F3 or scCtrl,
  1913.     VK_F4 or scCtrl,
  1914.     VK_F5 or scCtrl,
  1915.     VK_F6 or scCtrl,
  1916.     VK_F7 or scCtrl,
  1917.     VK_F8 or scCtrl,
  1918.     VK_F9 or scCtrl,
  1919.     VK_F10 or scCtrl,
  1920.     VK_F11 or scCtrl,
  1921.     VK_F12 or scCtrl,
  1922.     VK_F1 or scShift,
  1923.     VK_F2 or scShift,
  1924.     VK_F3 or scShift,
  1925.     VK_F4 or scShift,
  1926.     VK_F5 or scShift,
  1927.     VK_F6 or scShift,
  1928.     VK_F7 or scShift,
  1929.     VK_F8 or scShift,
  1930.     VK_F9 or scShift,
  1931.     VK_F10 or scShift,
  1932.     VK_F11 or scShift,
  1933.     VK_F12 or scShift,
  1934.     VK_F1 or scShift or scCtrl,
  1935.     VK_F2 or scShift or scCtrl,
  1936.     VK_F3 or scShift or scCtrl,
  1937.     VK_F4 or scShift or scCtrl,
  1938.     VK_F5 or scShift or scCtrl,
  1939.     VK_F6 or scShift or scCtrl,
  1940.     VK_F7 or scShift or scCtrl,
  1941.     VK_F8 or scShift or scCtrl,
  1942.     VK_F9 or scShift or scCtrl,
  1943.     VK_F10 or scShift or scCtrl,
  1944.     VK_F11 or scShift or scCtrl,
  1945.     VK_F12 or scShift or scCtrl,
  1946.     VK_INSERT,
  1947.     VK_INSERT or scShift,
  1948.     VK_INSERT or scCtrl,
  1949.     VK_DELETE,
  1950.     VK_DELETE or scShift,
  1951.     VK_DELETE or scCtrl,
  1952.     VK_BACK or scAlt,
  1953.     VK_BACK or scShift or scAlt);
  1954.  
  1955. function TShortCutProperty.GetAttributes: TPropertyAttributes;
  1956. begin
  1957.   Result := [paMultiSelect, paValueList, paRevertable];
  1958. end;
  1959.  
  1960. function TShortCutProperty.GetValue: string;
  1961. var
  1962.   CurValue: TShortCut;
  1963. begin
  1964.   CurValue := GetOrdValue;
  1965.   if CurValue = scNone then
  1966.     Result := srNone else
  1967.     Result := ShortCutToText(CurValue);
  1968. end;
  1969.  
  1970. procedure TShortCutProperty.GetValues(Proc: TGetStrProc);
  1971. var
  1972.   I: Integer;
  1973. begin
  1974.   Proc(srNone);
  1975.   for I := 1 to High(ShortCuts) do Proc(ShortCutToText(ShortCuts[I]));
  1976. end;
  1977.  
  1978. procedure TShortCutProperty.SetValue(const Value: string);
  1979. var
  1980.   NewValue: TShortCut;
  1981. begin
  1982.   NewValue := 0;
  1983.   if (Value <> '') and (AnsiCompareText(Value, srNone) <> 0) then
  1984.   begin
  1985.     NewValue := TextToShortCut(Value);
  1986.     if NewValue = 0 then
  1987.       raise EPropertyError.Create(SInvalidPropertyValue);
  1988.   end;
  1989.   SetOrdValue(NewValue);
  1990. end;
  1991.  
  1992. { TTabOrderProperty }
  1993.  
  1994. function TTabOrderProperty.GetAttributes: TPropertyAttributes;
  1995. begin
  1996.   Result := [];
  1997. end;
  1998.  
  1999. { TCaptionProperty }
  2000.  
  2001. function TCaptionProperty.GetAttributes: TPropertyAttributes;
  2002. begin
  2003.   Result := [paMultiSelect, paAutoUpdate, paRevertable];
  2004. end;
  2005.  
  2006. { TDateProperty }
  2007.  
  2008. function TDateProperty.GetAttributes: TPropertyAttributes;
  2009. begin
  2010.   Result := [paMultiSelect, paRevertable];
  2011. end;
  2012.  
  2013. function TDateProperty.GetValue: string;
  2014. var
  2015.   DT: TDateTime;
  2016. begin
  2017.   DT := GetFloatValue;
  2018.   if DT = 0.0 then Result := '' else
  2019.   Result := DateToStr(DT);
  2020. end;
  2021.  
  2022. procedure TDateProperty.SetValue(const Value: string);
  2023. var
  2024.   DT: TDateTime;
  2025. begin
  2026.   if Value = '' then DT := 0.0
  2027.   else DT := StrToDate(Value);
  2028.   SetFloatValue(DT);
  2029. end;
  2030.  
  2031. { TTimeProperty }
  2032.  
  2033. function TTimeProperty.GetAttributes: TPropertyAttributes;
  2034. begin
  2035.   Result := [paMultiSelect, paRevertable];
  2036. end;
  2037.  
  2038. function TTimeProperty.GetValue: string;
  2039. var
  2040.   DT: TDateTime;
  2041. begin
  2042.   DT := GetFloatValue;
  2043.   if DT = 0.0 then Result := '' else
  2044.   Result := TimeToStr(DT);
  2045. end;
  2046.  
  2047. procedure TTimeProperty.SetValue(const Value: string);
  2048. var
  2049.   DT: TDateTime;
  2050. begin
  2051.   if Value = '' then DT := 0.0
  2052.   else DT := StrToTime(Value);
  2053.   SetFloatValue(DT);
  2054. end;
  2055.  
  2056. { TPropInfoList }
  2057.  
  2058. type
  2059.   TPropInfoList = class
  2060.   private
  2061.     FList: PPropList;
  2062.     FCount: Integer;
  2063.     FSize: Integer;
  2064.     function Get(Index: Integer): PPropInfo;
  2065.   public
  2066.     constructor Create(Instance: TPersistent; Filter: TTypeKinds);
  2067.     destructor Destroy; override;
  2068.     function Contains(P: PPropInfo): Boolean;
  2069.     procedure Delete(Index: Integer);
  2070.     procedure Intersect(List: TPropInfoList);
  2071.     property Count: Integer read FCount;
  2072.     property Items[Index: Integer]: PPropInfo read Get; default;
  2073.   end;
  2074.  
  2075. constructor TPropInfoList.Create(Instance: TPersistent; Filter: TTypeKinds);
  2076. begin
  2077.   FCount := GetPropList(Instance.ClassInfo, Filter, nil);
  2078.   FSize := FCount * SizeOf(Pointer);
  2079.   GetMem(FList, FSize);
  2080.   GetPropList(Instance.ClassInfo, Filter, FList);
  2081. end;
  2082.  
  2083. destructor TPropInfoList.Destroy;
  2084. begin
  2085.   if FList <> nil then FreeMem(FList, FSize);
  2086. end;
  2087.  
  2088. function TPropInfoList.Contains(P: PPropInfo): Boolean;
  2089. var
  2090.   I: Integer;
  2091. begin
  2092.   for I := 0 to FCount - 1 do
  2093.     with FList^[I]^ do
  2094.       if (PropType = P^.PropType) and (CompareText(Name, P^.Name) = 0) then
  2095.       begin
  2096.         Result := True;
  2097.         Exit;
  2098.       end;
  2099.   Result := False;
  2100. end;
  2101.  
  2102. procedure TPropInfoList.Delete(Index: Integer);
  2103. begin
  2104.   Dec(FCount);
  2105.   if Index < FCount then
  2106.     Move(FList^[Index + 1], FList^[Index],
  2107.       (FCount - Index) * SizeOf(Pointer));
  2108. end;
  2109.  
  2110. function TPropInfoList.Get(Index: Integer): PPropInfo;
  2111. begin
  2112.   Result := FList^[Index];
  2113. end;
  2114.  
  2115. procedure TPropInfoList.Intersect(List: TPropInfoList);
  2116. var
  2117.   I: Integer;
  2118. begin
  2119.   for I := FCount - 1 downto 0 do
  2120.     if not List.Contains(FList^[I]) then Delete(I);
  2121. end;
  2122.  
  2123. { GetComponentProperties }
  2124.  
  2125. procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  2126.   const PropertyName: string; EditorClass: TPropertyEditorClass);
  2127. var
  2128.   P: PPropertyClassRec;
  2129. begin
  2130.   if PropertyClassList = nil then
  2131.     PropertyClassList := TList.Create;
  2132.   New(P);
  2133.   P.Group := CurrentGroup;
  2134.   P.PropertyType := PropertyType;
  2135.   P.ComponentClass := ComponentClass;
  2136.   P.PropertyName := '';
  2137.   if Assigned(ComponentClass) then P^.PropertyName := PropertyName;
  2138.   P.EditorClass := EditorClass;
  2139.   PropertyClassList.Insert(0, P);
  2140. end;
  2141.  
  2142. procedure RegisterPropertyMapper(Mapper: TPropertyMapperFunc);
  2143. var
  2144.   P: PPropertyMapperRec;
  2145. begin
  2146.   if PropertyMapperList = nil then
  2147.     PropertyMapperList := TList.Create;
  2148.   New(P);
  2149.   P^.Group := CurrentGroup;
  2150.   P^.Mapper := Mapper;
  2151.   PropertyMapperList.Insert(0, P);
  2152. end;
  2153.  
  2154. function GetEditorClass(PropInfo: PPropInfo;
  2155.   Obj: TPersistent): TPropertyEditorClass;
  2156. var
  2157.   PropType: PTypeInfo;
  2158.   P, C: PPropertyClassRec;
  2159.   I: Integer;
  2160. begin
  2161.   if PropertyMapperList <> nil then
  2162.   begin
  2163.     for I := 0 to PropertyMapperList.Count -1 do
  2164.       with PPropertyMapperRec(PropertyMapperList[I])^ do
  2165.       begin
  2166.         Result := Mapper(Obj, PropInfo);
  2167.         if Result <> nil then Exit;
  2168.       end;
  2169.   end;
  2170.   PropType := PropInfo^.PropType^;
  2171.   I := 0;
  2172.   C := nil;
  2173.   while I < PropertyClassList.Count do
  2174.   begin
  2175.     P := PropertyClassList[I];
  2176.     if ((P^.PropertyType = PropType) or ((PropType^.Kind = tkClass) and
  2177.       (P^.PropertyType^.Kind = tkClass) and
  2178.       GetTypeData(PropType)^.ClassType.InheritsFrom(GetTypeData(P^.PropertyType)^.ClassType))) and
  2179.       ((P^.ComponentClass = nil) or (Obj.InheritsFrom(P^.ComponentClass))) and
  2180.       ((P^.PropertyName = '') or (CompareText(PropInfo^.Name, P^.PropertyName) = 0)) then
  2181.       if (C = nil) or ((C^.ComponentClass = nil) and (P^.ComponentClass <> nil))
  2182.         or ((C^.PropertyName = '') and (P^.PropertyName <> '')) then C := P;
  2183.     Inc(I);
  2184.   end;
  2185.   if C <> nil then
  2186.     Result := C^.EditorClass else
  2187.     Result := PropClassMap[PropType^.Kind];
  2188. end;
  2189.  
  2190. procedure GetComponentProperties(Components: TComponentList;
  2191.   Filter: TTypeKinds; Designer: TFormDesigner; Proc: TGetPropEditProc);
  2192. var
  2193.   I, J, CompCount: Integer;
  2194.   CompType: TClass;
  2195.   Candidates: TPropInfoList;
  2196.   PropLists: TList;
  2197.   Editor: TPropertyEditor;
  2198.   EdClass: TPropertyEditorClass;
  2199.   PropInfo: PPropInfo;
  2200.   AddEditor: Boolean;
  2201.   Obj: TPersistent;
  2202. begin
  2203.   if (Components = nil) or (Components.Count = 0) then Exit;
  2204.   CompCount := Components.Count;
  2205.   Obj := Components[0];
  2206.   CompType := Components[0].ClassType;
  2207.   Candidates := TPropInfoList.Create(Components[0], Filter);
  2208.   try
  2209.     for I := Candidates.Count - 1 downto 0 do
  2210.     begin
  2211.       PropInfo := Candidates[I];
  2212.       EdClass := GetEditorClass(PropInfo, Obj);
  2213.       if EdClass = nil then
  2214.         Candidates.Delete(I)
  2215.       else
  2216.       begin
  2217.         Editor := EdClass.Create(Designer, 1);
  2218.         try
  2219.           Editor.SetPropEntry(0, Components[0], PropInfo);
  2220.           Editor.Initialize;
  2221.           with PropInfo^ do
  2222.             if (GetProc = nil) or ((PropType^.Kind <> tkClass) and
  2223.               (SetProc = nil)) or ((CompCount > 1) and
  2224.               not (paMultiSelect in Editor.GetAttributes)) or
  2225.               not Editor.ValueAvailable then
  2226.               Candidates.Delete(I);
  2227.         finally
  2228.           Editor.Free;
  2229.         end;
  2230.       end;
  2231.     end;
  2232.     PropLists := TList.Create;
  2233.     try
  2234.       PropLists.Capacity := CompCount;
  2235.       for I := 0 to CompCount - 1 do
  2236.         PropLists.Add(TPropInfoList.Create(Components[I], Filter));
  2237.       for I := 0 to CompCount - 1 do
  2238.         Candidates.Intersect(TPropInfoList(PropLists[I]));
  2239.       for I := 0 to CompCount - 1 do
  2240.         TPropInfoList(PropLists[I]).Intersect(Candidates);
  2241.       for I := 0 to Candidates.Count - 1 do
  2242.       begin
  2243.         EdClass := GetEditorClass(Candidates[I], Obj);
  2244.         if EdClass = nil then Continue;
  2245.         Editor := EdClass.Create(Designer, CompCount);
  2246.         try
  2247.           AddEditor := True;
  2248.           for J := 0 to CompCount - 1 do
  2249.           begin
  2250.             if (Components[J].ClassType <> CompType) and
  2251.               (GetEditorClass(TPropInfoList(PropLists[J])[I],
  2252.                 Components[J]) <> Editor.ClassType) then
  2253.             begin
  2254.               AddEditor := False;
  2255.               Break;
  2256.             end;
  2257.             Editor.SetPropEntry(J, Components[J],
  2258.               TPropInfoList(PropLists[J])[I]);
  2259.           end;
  2260.         except
  2261.           Editor.Free;
  2262.           raise;
  2263.         end;
  2264.         if AddEditor then
  2265.         begin
  2266.           Editor.Initialize;
  2267.           if Editor.ValueAvailable then
  2268.             Proc(Editor) else
  2269.             Editor.Free;
  2270.         end
  2271.         else Editor.Free;
  2272.       end;
  2273.     finally
  2274.       for I := 0 to PropLists.Count - 1 do TPropInfoList(PropLists[I]).Free;
  2275.       PropLists.Free;
  2276.     end;
  2277.   finally
  2278.     Candidates.Free;
  2279.   end;
  2280. end;
  2281.  
  2282. { RegisterComponentEditor }
  2283.  
  2284. type
  2285.   PComponentClassRec = ^TComponentClassRec;
  2286.   TComponentClassRec = record
  2287.     Group: Integer;
  2288.     ComponentClass: TComponentClass;
  2289.     EditorClass: TComponentEditorClass;
  2290.   end;
  2291.  
  2292. var
  2293.   ComponentClassList: TList = nil;
  2294.  
  2295. procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  2296.   ComponentEditor: TComponentEditorClass);
  2297. var
  2298.   P: PComponentClassRec;
  2299. begin
  2300.   if ComponentClassList = nil then
  2301.     ComponentClassList := TList.Create;
  2302.   New(P);
  2303.   P.Group := CurrentGroup;
  2304.   P.ComponentClass := ComponentClass;
  2305.   P.EditorClass := ComponentEditor;
  2306.   ComponentClassList.Insert(0, P);
  2307. end;
  2308.  
  2309. { GetComponentEditor }
  2310.  
  2311. function GetComponentEditor(Component: TComponent;
  2312.   Designer: TFormDesigner): TComponentEditor;
  2313. var
  2314.   P: PComponentClassRec;
  2315.   I: Integer;
  2316.   ComponentClass: TComponentClass;
  2317.   EditorClass: TComponentEditorClass;
  2318. begin
  2319.   ComponentClass := TComponent;
  2320.   EditorClass := TDefaultEditor;
  2321.   for I := 0 to ComponentClassList.Count-1 do
  2322.   begin
  2323.     P := ComponentClassList[I];
  2324.     if (Component is P^.ComponentClass) and
  2325.       (P^.ComponentClass.InheritsFrom(ComponentClass)) then
  2326.     begin
  2327.       EditorClass := P^.EditorClass;
  2328.       ComponentClass := P^.ComponentClass;
  2329.       Break;  //!! temporary
  2330.     end;
  2331.   end;
  2332.   Result := EditorClass.Create(Component, Designer);
  2333. end;
  2334.  
  2335. function NewEditorGroup: Integer;
  2336. begin
  2337.   if EditorGroupList = nil then
  2338.     EditorGroupList := TBits.Create;
  2339.   CurrentGroup := EditorGroupList.OpenBit;
  2340.   EditorGroupList[CurrentGroup] := True;
  2341.   Result := CurrentGroup;
  2342. end;
  2343.  
  2344. procedure FreeEditorGroup(Group: Integer);
  2345. var
  2346.   I: Integer;
  2347.   P: PPropertyClassRec;
  2348.   C: PComponentClassRec;
  2349.   M: PPropertyMapperRec;
  2350. begin
  2351.   I := PropertyClassList.Count - 1;
  2352.   while I > -1 do
  2353.   begin
  2354.     P := PropertyClassList[I];
  2355.     if P.Group = Group then
  2356.     begin
  2357.       PropertyClassList.Delete(I);
  2358.       Dispose(P);
  2359.     end;
  2360.     Dec(I);
  2361.   end;
  2362.   I := ComponentClassList.Count - 1;
  2363.   while I > -1 do
  2364.   begin
  2365.     C := ComponentClassList[I];
  2366.     if C.Group = Group then
  2367.     begin
  2368.       ComponentClassList.Delete(I);
  2369.       Dispose(C);
  2370.     end;
  2371.     Dec(I);
  2372.   end;
  2373.   if PropertyMapperList <> nil then
  2374.     for I := PropertyMapperList.Count-1 downto 0 do
  2375.     begin
  2376.       M := PropertyMapperList[I];
  2377.       if M.Group = Group then
  2378.       begin
  2379.         PropertyMapperList.Delete(I);
  2380.         Dispose(M);
  2381.       end;
  2382.     end;
  2383.   if Assigned(FreeCustomModulesProc) then FreeCustomModulesProc(Group);
  2384.   if (Group >= 0) and (Group < EditorGroupList.Size) then
  2385.     EditorGroupList[Group] := False;
  2386. end;
  2387.  
  2388. { TComponentEditor }
  2389.  
  2390. constructor TComponentEditor.Create(AComponent: TComponent; ADesigner: TFormDesigner);
  2391. begin
  2392.   inherited Create;
  2393.   FComponent := AComponent;
  2394.   FDesigner := ADesigner;
  2395. end;
  2396.  
  2397. procedure TComponentEditor.Edit;
  2398. begin
  2399.   if GetVerbCount > 0 then ExecuteVerb(0);
  2400. end;
  2401.  
  2402. function TComponentEditor.GetVerbCount: Integer;
  2403. begin
  2404.   Result := 0;
  2405. end;
  2406.  
  2407. function TComponentEditor.GetVerb(Index: Integer): string;
  2408. begin
  2409. end;
  2410.  
  2411. procedure TComponentEditor.ExecuteVerb(Index: Integer);
  2412. begin
  2413. end;
  2414.  
  2415. procedure TComponentEditor.Copy;
  2416. begin
  2417. end;
  2418.  
  2419. { TDefaultEditor }
  2420.  
  2421. procedure TDefaultEditor.CheckEdit(PropertyEditor: TPropertyEditor);
  2422. var
  2423.   FreeEditor: Boolean;
  2424. begin
  2425.   FreeEditor := True;
  2426.   try
  2427.     if FContinue then EditProperty(PropertyEditor, FContinue, FreeEditor);
  2428.   finally
  2429.     if FreeEditor then PropertyEditor.Free;
  2430.   end;
  2431. end;
  2432.  
  2433. procedure TDefaultEditor.EditProperty(PropertyEditor: TPropertyEditor;
  2434.   var Continue, FreeEditor: Boolean);
  2435. var
  2436.   PropName: string;
  2437.   BestName: string;
  2438.  
  2439.   procedure ReplaceBest;
  2440.   begin
  2441.     FBest.Free;
  2442.     FBest := PropertyEditor;
  2443.     if FFirst = FBest then FFirst := nil;
  2444.     FreeEditor := False;
  2445.   end;
  2446.  
  2447. begin
  2448.   if not Assigned(FFirst) and (PropertyEditor is TMethodProperty) then
  2449.   begin
  2450.     FreeEditor := False;
  2451.     FFirst := PropertyEditor;
  2452.   end;
  2453.   PropName := PropertyEditor.GetName;
  2454.   BestName := '';
  2455.   if Assigned(FBest) then BestName := FBest.GetName;
  2456.   if CompareText(PropName, 'ONCREATE') = 0 then
  2457.     ReplaceBest
  2458.   else if CompareText(BestName, 'ONCREATE') <> 0 then
  2459.     if CompareText(PropName, 'ONCHANGE') = 0 then
  2460.       ReplaceBest
  2461.     else if CompareText(BestName, 'ONCHANGE') <> 0 then
  2462.       if CompareText(PropName, 'ONCLICK') = 0 then
  2463.         ReplaceBest;
  2464. end;
  2465.  
  2466. procedure TDefaultEditor.Edit;
  2467. var
  2468.   Components: TComponentList;
  2469. begin
  2470.   Components := TComponentList.Create;
  2471.   try
  2472.     FContinue := True;
  2473.     Components.Add(Component);
  2474.     FFirst := nil;
  2475.     FBest := nil;
  2476.     try
  2477.       GetComponentProperties(Components, tkAny, Designer, CheckEdit);
  2478.       if FContinue then
  2479.         if Assigned(FBest) then
  2480.           FBest.Edit
  2481.         else if Assigned(FFirst) then
  2482.           FFirst.Edit;
  2483.     finally
  2484.       FFirst.Free;
  2485.       FBest.Free;
  2486.     end;
  2487.   finally
  2488.     Components.Free;
  2489.   end;
  2490. end;
  2491.  
  2492. { TCustomModule }
  2493.  
  2494. constructor TCustomModule.Create(ARoot: TComponent);
  2495. begin
  2496.   inherited Create;
  2497.   FRoot := ARoot;
  2498. end;
  2499.  
  2500. procedure TCustomModule.ExecuteVerb(Index: Integer);
  2501. begin
  2502. end;
  2503.  
  2504. function TCustomModule.GetAttributes: TCustomModuleAttributes;
  2505. begin
  2506.   Result := [];
  2507. end;
  2508.  
  2509. function TCustomModule.GetVerb(Index: Integer): string;
  2510. begin
  2511.   Result := '';
  2512. end;
  2513.  
  2514. function TCustomModule.GetVerbCount: Integer;
  2515. begin
  2516.   Result := 0;
  2517. end;
  2518.  
  2519. procedure TCustomModule.Saving;
  2520. begin
  2521. end;
  2522.  
  2523. procedure TCustomModule.ValidateComponent(Component: TComponent);
  2524. begin
  2525. end;
  2526.  
  2527. procedure RegisterCustomModule(ComponentBaseClass: TComponentClass;
  2528.   CustomModuleClass: TCustomModuleClass);
  2529. begin
  2530.   if Assigned(RegisterCustomModuleProc) then
  2531.     RegisterCustomModuleProc(CurrentGroup, ComponentBaseClass,
  2532.       CustomModuleClass);
  2533. end;
  2534.  
  2535. initialization
  2536.  
  2537. finalization
  2538.   EditorGroupList.Free;
  2539.   PropertyClassList.Free;
  2540.   ComponentClassList.Free;
  2541.   PropertyMapperList.Free;
  2542.  
  2543. end.
  2544.